model <- readRDS(paste(path,day,file,sep=""))
remove(day,file, path)
# Model outputs
Y.fit <- model[[1]]
# Calibration-Validation stats
CRSQ <- model[[2]]
VRSQ <- model[[3]]
VRE  <- model[[4]]
VCE  <- model[[5]]
# Other info
X               <- model[[6]]
X_details       <- model[[7]]
nest_start_final<- model[[8]]
nest_stop_final <- model[[9]]
nest_years      <- model[[10]]
num_models      <- model[[11]]
r.weights       <- model[[12]]
n.iterations    <- model[[13]]
Q       <- model[[14]]
Q_years <- model[[15]]
p.mean  <- model[[16]]
p.MSQ   <- model[[17]]
remove(model)
View(X_details)
View(X_details)
View(X)
View(Q)
as.numeric(rownames(X_details))
X.cal <- X[nest_years>=1956 & nest_years <=1998]
Q.cal <- Q[Q_years>=1956 & Q_yr<=1998]
# Calibration period correlations b/w PC series and JAS discharge
X.cal <- X[nest_years>=1956 & nest_years <=1998]
Q.cal <- Q[Q_years>=1956 & Q_years<=1998]
# Calibration period correlations b/w PC series and JAS discharge
X.cal <- X[nest_years>=1956 & nest_years <=1998,]
Q.cal <- Q[Q_years>=1956 & Q_years<=1998,]
X.PC.scores <- principal(X.cal, nfactors=ncol(X.cal),rotate = "none")
library("psych")   # PCA
X.PC.scores <- principal(X.cal, nfactors=ncol(X.cal),rotate = "none")
View(X.PC.scores)
X.PC.scores
X.PC.scores$scores
apply(X.PC.scores$scores,2,function(x) cor(x,Q.cal,use='pairwise'))
eigenvals
eigenvals <- round(X.PC.scores$values,1)
eigenvals
eigenvals>=1
apply(X.PC.scores$scores[,pos],2,function(x) cor(x,Q.cal,use='pairwise'))
pos <- eigenvals>=1
apply(X.PC.scores$scores[,pos],2,function(x) cor(x,Q.cal,use='pairwise'))
?cor
plot(X.PC.scores[,1],Q.cal)
plot(X.PC.scores$scores[,1],Q.cal)
plot(scale(X.PC.scores$scores[,1]),Q.cal)
plot(scale(X.PC.scores$scores[,1]),Q.cal,las=1)
# Number of series
num.series <- NULL
for (i in 1:length(nest_start_final)){
num.series[i] <- sum(!is.na((X[(which(nest_years==nest_start_final[i])),])))
}
num.series <- replicate_stats(nest_start_final, nest_stop_final, nest_years, matrix(num.series))
num.series <- as.matrix(t(num.series))
# Convert matrix with calibration-validation value for each nest to align with reconstruction years
replicate_stats <- function(nest_start_final, nest_stop_final, nest_years, dat){
temp <- matrix(NA,nrow=length(nest_years), ncol=dim(dat)[2])
for (i in 1:length(nest_start_final))
{
b <- which(nest_years==nest_start_final[i])
a <- which(nest_years==nest_stop_final[i])
temp[seq(b,a,by=1),] <- t(replicate((a-b+1), dat[i,]))
}
rownames(temp) <- nest_years
median.quantile <- t(apply(temp,1, median, na.rm = TRUE))
# Returning data
return(median.quantile)
}
# Number of series
num.series <- NULL
for (i in 1:length(nest_start_final)){
num.series[i] <- sum(!is.na((X[(which(nest_years==nest_start_final[i])),])))
}
num.series <- replicate_stats(nest_start_final, nest_stop_final, nest_years, matrix(num.series))
num.series <- as.matrix(t(num.series))
colnames(num.series) <- "num.series"
unique(num.series)
X.PC.scores$scores[,pos]
X.PC.scores$scores[,1:2]
5:28
X.cal <- X[nest_years>=1956 & nest_years <=1998,5:28]
X.cal <- X[nest_years>=1956 & nest_years <=1998,6:28]
Q.cal <- Q[Q_years>=1956 & Q_years<=1998,]
library("psych")   # PCA
X.PC.scores <- principal(X.cal, nfactors=ncol(X.cal),rotate = "none")
X.PC.scores
eigenvals <- round(X.PC.scores$values,1)
pos <- eigenvals>=1
apply(X.PC.scores$scores[,1:2],2,function(x) cor(x,Q.cal,use='pairwise'))
apply(X.PC.scores$scores[,pos],2,function(x) cor(x,Q.cal,use='pairwise'))
X.PC.scores$scores[,1:2]
X.cal <- X[nest_years>=1956 & nest_years <=1998,11:28]
# Calibration period correlations b/w PC series and JAS discharge
X.cal <- X[nest_years>=1956 & nest_years <=1998,12:28]
Q.cal <- Q[Q_years>=1956 & Q_years<=1998,]
library("psych")   # PCA
X.PC.scores <- principal(X.cal, nfactors=ncol(X.cal),rotate = "none")
eigenvals <- round(X.PC.scores$values,1)
pos <- eigenvals>=1
apply(X.PC.scores$scores[,pos],2,function(x) cor(x,Q.cal,use='pairwise'))
plot(scale(X.PC.scores$scores[,1]),Q.cal,las=1)
X.PC.scores$scores[,1:2]
X.cal <- X[nest_years>=1956 & nest_years <=1998,18:28]
# Calibration period correlations b/w PC series and JAS discharge
X.cal <- X[nest_years>=1956 & nest_years <=1998,19:28]
Q.cal <- Q[Q_years>=1956 & Q_years<=1998,]
library("psych")   # PCA
X.PC.scores <- principal(X.cal, nfactors=ncol(X.cal),rotate = "none")
eigenvals <- round(X.PC.scores$values,1)
pos <- eigenvals>=1
apply(X.PC.scores$scores[,pos],2,function(x) cor(x,Q.cal,use='pairwise'))
X.PC.scores$scores[,c(1,3)]
i-1
i=1
# Calibration period correlations b/w PC series and JAS discharge
X.cal <- X[nest_years>=1956 & nest_years <=1998,]
Q.cal <- Q[Q_years>=1956 & Q_years<=1998,]
library("psych")   # PCA
r_PC_flow <- NULL
n <- c(28,25,22,21,20,14,12,11)
X.cal[,seq((28-28+1),28)]
(28-(n[i])+1)
X.PC.scores <- principal(X.cal[,seq((28-(n[i])+1),28)], nfactors=ncol(X.cal),rotate = "none")
apply(X.PC.scores$scores[,seq(1:5)],2,function(x) cor(x,Q.cal,use='pairwise')))
apply(X.PC.scores$scores[,seq(1:5)],2,function(x) cor(x,Q.cal,use='pairwise'))
rbind(r_PC_flow,apply(X.PC.scores$scores[,seq(1:5)],2,function(x) cor(x,Q.cal,use='pairwise')))
i=2
seq((28-(n[i])+1)
,28)
X.cal[,seq((28-(n[i])+1),28)]
# Calibration period correlations b/w PC series and JAS discharge
X.cal <- X[nest_years>=1956 & nest_years <=1998,]
Q.cal <- Q[Q_years>=1956 & Q_years<=1998,]
library("psych")   # PCA
r_PC_flow <- NULL
n <- c(28,25,22,21,20,14,12,11,10)
t <- NULL
for (i in 1:length(n)) {
t[i] <- (28-(n[i])+1)
X.PC.scores <- principal(X.cal[,seq(t[i],28)], nfactors=ncol(X.cal),rotate = "none")
r_PC_flow <- rbind(r_PC_flow,apply(X.PC.scores$scores[,seq(1:5)],2,function(x) cor(x,Q.cal,use='pairwise')))
}
r_PC_flow
r_PC_flow
i
length(n)
# Calibration period correlations b/w PC series and JAS discharge
X.cal <- X[nest_years>=1956 & nest_years <=1998,]
Q.cal <- Q[Q_years>=1956 & Q_years<=1998,]
library("psych")   # PCA
r_PC_flow <- NULL
n <- c(28,25,22,21,20,14,12,11,10)
t <- NULL
for (i in 1:length(n)) {
t[i] <- (28-(n[i])+1)
X.PC.scores <- principal(X.cal[,seq(t[i],28)], nfactors=ncol(X.cal),rotate = "none")
r_PC_flow <- rbind(r_PC_flow,apply(X.PC.scores$scores[,seq(1:5)],2,function(x) cor(x,Q.cal,use='pairwise')))
}
r_PC_flow
(28-(n[i])+1)
X.cal[,seq(t[i],28)]
t
# Calibration period correlations b/w PC series and JAS discharge
X.cal <- X[nest_years>=1956 & nest_years <=1998,]
Q.cal <- Q[Q_years>=1956 & Q_years<=1998,]
library("psych")   # PCA
r_PC_flow <- NULL
n <- c(28,25,22,21,20,14,12,11,10)
t <- NULL
for (i in 1:length(n)) {
t[i] <- (28-(n[i])+1)
X_cal_temp <- X.cal[,seq(t[i],28)]
X.PC.scores <- principal(X_cal_temp, nfactors=ncol(X_cal_temp),rotate = "none")
r_PC_flow <- rbind(r_PC_flow,apply(X.PC.scores$scores[,seq(1:5)],2,function(x) cor(x,Q.cal,use='pairwise')))
}
r_PC_flow
# Calibration period correlations b/w PC series and JAS discharge
X.cal <- X[nest_years>=1956 & nest_years <=1998,]
Q.cal <- Q[Q_years>=1956 & Q_years<=1998,]
library("psych")   # PCA
r_PC_flow <- NULL
n <- c(28,25,22,21,20,14,12,11,10)
t <- NULL
for (i in 1:length(n)) {
t[i] <- (28-(n[i])+1)
X_cal_temp <- X.cal[,seq(t[i],28)]
X.PC.scores <- principal(X_cal_temp, nfactors=ncol(X_cal_temp),rotate = "none")
r_PC_flow <- rbind(r_PC_flow,apply(X.PC.scores$scores[,seq(1:8)],2,function(x) cor(x,Q.cal,use='pairwise')))
}
r_PC_flow
apply(r_PC_flow,1,median)
apply(r_PC_flow,2,median)
apply(r_PC_flow,2,,min)
apply(r_PC_flow,2,min)
apply(r_PC_flow,2,max)
apply(abs(r_PC_flow),2,median)
apply(abs(r_PC_flow),2,mean)
apply(abs(r_PC_flow),2,median)
apply(r_PC_flow,2,min)
apply(r_PC_flow,2,max)
X.PC.scores
n=9
t[i] <- (28-(n[i])+1)
X_cal_temp <- X.cal[,seq(t[i],28)]
X.PC.scores <- principal(X_cal_temp, nfactors=ncol(X_cal_temp),rotate = "none")
X.PC.scores
apply(X.PC.scores$scores[,seq(1:8)],2,function(x) cor(x,Q.cal,use='pairwise'))
X.PC.scores$scores[,seq(1:8)]
X.PC.scores$scores[,seq(1:2)]
# Setting my working directory
setwd("~/Tree-Ring/Papers in progress/2018/Rao - Brahmaputra/codes/final/")
# Starting with clean workspace
rm(list=ls())
# Clearing cache of plots
dev.off()
# required packages, install if needed
if (!require("signal")) install.packages("signal")
library("signal") # For low-pass filter
# Loading reconstruction outputs
path <- c('model.out/')
day  <- c('20200406/')
file <- c('Bahadurabad_JAS_recon_20200406.rds')
model <- readRDS(paste(path,day,file,sep=""))
remove(day,file, path)
# Model outputs
Y.fit <- model[[1]]
# Calibration-Validation stats
CRSQ <- model[[2]]
VRSQ <- model[[3]]
VRE  <- model[[4]]
VCE  <- model[[5]]
# Other info
X               <- model[[6]]
X_details       <- model[[7]]
nest_start_final<- model[[8]]
nest_stop_final <- model[[9]]
nest_years      <- model[[10]]
num_models      <- model[[11]]
r.weights       <- model[[12]]
n.iterations    <- model[[13]]
Q       <- model[[14]]
Q_years <- model[[15]]
p.mean  <- model[[16]]
p.MSQ   <- model[[17]]
remove(model)
# Print nest years
print(nest_start_final)
# Convert matrix with calibration-validation value for each nest to align with reconstruction years
replicate_stats <- function(nest_start_final, nest_stop_final, nest_years, dat){
temp <- matrix(NA,nrow=length(nest_years), ncol=dim(dat)[2])
for (i in 1:length(nest_start_final))
{
b <- which(nest_years==nest_start_final[i])
a <- which(nest_years==nest_stop_final[i])
temp[seq(b,a,by=1),] <- t(replicate((a-b+1), dat[i,]))
}
rownames(temp) <- nest_years
median.quantile <- t(apply(temp,1, median, na.rm = TRUE))
# Returning data
return(median.quantile)
}
print("CRSQ, VRSQ, VRE, and VCE for each nest")
print(rbind(nest_start_final,
nest_stop_final,
round(apply(CRSQ,1,median),3),
round(apply(VRSQ,1,median),3),
round(apply(VRE,1,median),3),
round(apply(VCE,1,median),3)))
pos <- nest_years>=1956 & nest_years<=1998
print("Correlations b/w predictors and Q (calibration period - 1956-1998")
t(apply(X[pos,],2, function (x) cor(x,Q[1:43,1], use="pairwise.complete")))
remove(pos)
# Subset reconstruction to 1309-2004. This section has both VRSQ & VRE >= 0.3 indicating 'reasonably' good skill
start <- 1309; stop <- 2004
# If you want to output full reconstructed period
#start <- min(nest_start_final); stop <- max(nest_stop_final)
pos <- nest_start_final>=start & nest_stop_final <= stop
recon_years <- seq(start,stop)
# Calibration-Validation stats
nest_start_final <- nest_start_final[pos]
nest_stop_final  <- nest_stop_final[pos]
CRSQ <- CRSQ[pos,]
VRSQ <- VRSQ[pos,]
VRE  <- VRE[pos,]
VCE  <- VCE[pos,]
p.mean  <- p.mean[pos,]
p.MSQ  <- p.MSQ[pos,]
print("CRSQ, VRSQ, VRE, VCE, p.mean, and p.MSQ for each nest")
print(rbind(nest_start_final,
nest_stop_final,
round(apply(CRSQ,1,median),3),
round(apply(VRSQ,1,median),3),
round(apply(VRE,1,median),3),
round(apply(VCE,1,median),3),
round(apply(p.mean,1,median),3),
round(apply(p.MSQ,1,median),3)))
remove(pos)
# Y.fit subset to final reconstructed period
pos <- nest_years>=start & nest_years <= stop
nest_years <- nest_years[pos]
X <- X[pos,]
Y.fit <- lapply(Y.fit, function (x) x[pos,])
remove(pos)
# Plotting Calibration-Velidation stats as medians of r weights
r.indices <- seq(1,401,by=50)
# CRSQ
par(mfrow=c(2,2))
CRSQ.weights <- matrix(NA,nrow=length(recon_years),ncol=length(r.weights)+2,
dimnames = list(nest_years,c(paste("CRSQ",r.weights,sep="_"),"CRSQ_r_med", "CRSQ_med")))
VRSQ.weights <- matrix(NA,nrow=length(recon_years),ncol=length(r.weights)+2,
dimnames = list(nest_years,c(paste("VRSQ",r.weights,sep="_"),"VRSQ_r_med", "VRSQ_med")))
VRE.weights  <- matrix(NA,nrow=length(recon_years),ncol=length(r.weights)+2,
dimnames = list(nest_years,c(paste("VRE",r.weights,sep="_"),"VRE_r_med", "VRE_med")))
VCE.weights  <- matrix(NA,nrow=length(recon_years),ncol=length(r.weights)+2,
dimnames = list(nest_years,c(paste("VCE",r.weights,sep="_"),"VCE_r_med", "VCE_med")))
for (i in 1:length(r.weights)){
a <- r.indices[i]
b <- r.indices[i+1]-1
crsq.temp <- CRSQ[,seq(a,b,by=1)]
vrsq.temp <- VRSQ[,seq(a,b,by=1)]
vre.temp <-   VRE[,seq(a,b,by=1)]
vce.temp <-   VCE[,seq(a,b,by=1)]
CRSQ.weights[,i] <- t(replicate_stats(nest_start_final,nest_stop_final,nest_years,crsq.temp))
VRSQ.weights[,i] <- t(replicate_stats(nest_start_final,nest_stop_final,nest_years,vrsq.temp))
VRE.weights[,i]  <- t(replicate_stats(nest_start_final,nest_stop_final,nest_years, vre.temp))
VCE.weights[,i]  <- t(replicate_stats(nest_start_final,nest_stop_final,nest_years, vce.temp))
remove(crsq.temp,vrsq.temp,vre.temp,vce.temp,a,b)
}
remove(i)
# Median across median of each correlation weight
CRSQ.weights[,9] <- apply(CRSQ.weights[,(1:length(r.weights))],1,median)
VRSQ.weights[,9] <- apply(VRSQ.weights[,(1:length(r.weights))],1,median)
VRE.weights[,9]  <-  apply(VRE.weights[,(1:length(r.weights))],1,median)
VCE.weights[,9]  <-  apply(VCE.weights[,(1:length(r.weights))],1,median)
# Median across all 400 iterations
CRSQ.weights[,10] <- replicate_stats(nest_start_final,nest_stop_final,nest_years,CRSQ)
VRSQ.weights[,10] <- replicate_stats(nest_start_final,nest_stop_final,nest_years,VRSQ)
VRE.weights[,10]  <- replicate_stats(nest_start_final,nest_stop_final,nest_years,VRE)
VCE.weights[,10]  <- replicate_stats(nest_start_final,nest_stop_final,nest_years,VCE)
# Calibration-Validation ALL
cal.ver.out <- cbind(CRSQ.weights,VRSQ.weights,VRE.weights,VCE.weights)
# Plot of CRSQ, VRSQ, VRE, and VCE
# CRSQ
xlim1 <- 1300; xlim2 <- 2020
par(mfrow=c(2,2))
plot(nest_years,CRSQ.weights[,10],ylim=c(0,0.8), xlim=c(xlim1, xlim2),type = 'l',ylab = "CRSQ",
xlab = "", las = 1, cex.lab=1.5, cex.axis = 1.5, col="black", lwd=2)
axis(side = 1, tck=.05,  labels=FALSE); abline(h=0, lwd=2, lty=2)
apply(CRSQ.weights[,(1:length(r.weights))],2, function(x) lines(nest_years,x,lwd=1,lty = 1, col="firebrick2"))
lines(nest_years,CRSQ.weights[,10], lwd=3, type = 'l')
lines(nest_years,CRSQ.weights[,9], lwd=3, type = 'l', col='blue')
# VRSQ
plot(nest_years,VRSQ.weights[,10],ylim=c(0,0.8), xlim=c(xlim1, xlim2),type = 'l',ylab = "VRSQ",
xlab = "", las = 1, cex.lab=1.5, cex.axis = 1.5, col="black", lwd=2)
axis(side = 1, tck=.05,  labels=FALSE); abline(h=0, lwd=2, lty=2)
apply(VRSQ.weights[,(1:length(r.weights))],2, function(x) lines(nest_years,x,lwd=1,lty = 1, col="firebrick2"))
lines(nest_years,VRSQ.weights[,10], lwd=3, type = 'l')
lines(nest_years,VRSQ.weights[,9], lwd=3, type = 'l', col='blue')
# VRE
plot(nest_years,VRE.weights[,10],ylim=c(-0.1,0.6), xlim=c(xlim1, xlim2),type = 'l',ylab = "VRE",
xlab = "", las = 1, cex.lab=1.5, cex.axis = 1.5, col="black", lwd=2)
axis(side = 1, tck=.05,  labels=FALSE); abline(h=0, lwd=2, lty=2)
apply(VRE.weights[,(1:length(r.weights))],2, function(x) lines(nest_years,x,lwd=1,lty = 1, col="firebrick2"))
lines(nest_years,VRE.weights[,10], lwd=3, type = 'l')
lines(nest_years,VRE.weights[,9], lwd=3, type = 'l', col='blue')
# VCE
plot(nest_years,VCE.weights[,10],ylim=c(-0.1,0.6), xlim=c(xlim1, xlim2),type = 'l',ylab = "VCE",
xlab = "", las = 1, cex.lab=1.5, cex.axis = 1.5, col="black", lwd=2)
axis(side = 1, tck=.05,  labels=FALSE); abline(h=0, lwd=2, lty=2)
apply(VCE.weights[,(1:length(r.weights))],2, function(x) lines(nest_years,x,lwd=1,lty = 1, col="firebrick2"))
lines(nest_years,VCE.weights[,10], lwd=3, type = 'l')
lines(nest_years,VCE.weights[,9], lwd=3, type = 'l', col='blue')
# Median Calibration Validation Statistics #
pos <- nest_years>=start & nest_years<=stop
median.cal.ver <- rbind(apply(CRSQ.weights[pos,c(9:10)],2,median),
apply(VRSQ.weights[pos,c(9:10)],2,median),
apply(VRE.weights[pos,c(9:10)],2,median),
apply(VCE.weights[pos,c(9:10)],2,median))
rownames(median.cal.ver) <- c("CRSQ","VRSQ","VRE","VCE")
colnames(median.cal.ver) <- c("r.weights","all.iterations")
print(median.cal.ver)
remove(pos)
# Extracting y.fit data
Y.out <- function(Y,nest_years){
Y.out <- matrix(NA, nrow=length(nest_years), ncol = 3)
for (i in 1:3)
{
Y.out[,i] <- apply(do.call(cbind, lapply(Y, function(x) x[,i])), 1, median, na.rm=TRUE)
}
rownames(Y.out) <- nest_years
colnames(Y.out) <- c("p05", "median", "p95")
return(Y.out)
}
# Storing Y.fit.data
Y.fit.final <- Y.out(Y=Y.fit, nest_years)
mean(apply(do.call(cbind, lapply(Y.fit, function(x) x[,2])), 1, median, na.rm=TRUE))
lapply(Y.fit, function(x) x[,2])
Y.median.all <- do.call(cbind, lapply(Y.fit, function(x) x[,2]))
dim(Y.median.all)
apply(Y.median.all,1,mean)
apply(Y.median.all,2,mean)
mean(apply(Y.median.all,2,mean))
mean(apply(Y.median.all,1,median))
median(apply(Y.median.all,2,mean))
apply(Y.median.all,2,mean)
quantile(apply(Y.median.all,2,mean), c(0.05,0.50,0.95))
mean(apply(Y.median.all,1,median))
quantile(apply(Y.median.all,2,mean), c(0.05,0.50,0.95))
46993-46237.12
47861.98-46993
(868.98+755.88)/2
# 20yr Low-Pass filtered recon
bf <- signal::butter(2, (1/20)*2, type="low")
Y.fit.20.lp <- signal::filtfilt(bf,Y.fit.final[,2])
# Plot of reconstrucion
par(mfrow=c(1,1),
mar=(c(2,2,0.8,0.5)), oma=c(2,4,0,1), #, mai=c(0,1,1))
mgp=c(1,1,0))
y.lim.1 <- 20000
y.lim.2 <- 70000
plot(nest_years, Y.fit.final[,2], type="n",
ylim = c(y.lim.1, y.lim.2),
xlim = c(xlim1, xlim2),
ylab="", xlab="", xaxt='n',yaxt='n',
las =1, bty='n',
cex.lab=1.5, cex.axis = 1.5)
y_ticks <- round(seq(y.lim.1,y.lim.2, by = (y.lim.2-y.lim.1)/4))
polygon(c(nest_years,rev(nest_years)),c(Y.fit.final[,1],rev(Y.fit.final[,3])), col="#EBEBEB",border = NA)
for (i in 1:dim(Y.fit.final)[1]){
if (Y.fit.final[i,2] < mean(Y.fit.final[,2])) {
lines(c(nest_years[i],nest_years[i]), c(mean(Y.fit.final[,2]),Y.fit.final[i,2]),col = "#d95f0e")
} else{
lines(c(nest_years[i],nest_years[i]), c(mean(Y.fit.final[,2]),Y.fit.final[i,2]),col = "#2ca25f")
}
}
lines(nest_years[5:(length(nest_years)-5)],Y.fit.20.lp[5:(length(Y.fit.20.lp)-5)], lwd=2,col='black')
lines(Q_years, Q[,1], lwd=1, col="darkblue")
axis(side=2, las=1,
at = y_ticks,
labels=format(y_ticks,big.mark=",", scientific=FALSE),
cex.lab=1.3, cex.axis = 1.15)
axis(1,at=c(seq(1300,2000,by=100)), cex.axis=1.5, cex.lab=1.5)
abline(v=c(seq(1300,2000,by=100)), col=c("black"), lty=c(3), lwd=c(1))
abline(h=mean(Y.fit.final[,2]), col=c("black"), lty=c(3), lwd=c(1.5))
mtext(expression(paste("Discharge (",m^3,"/",s,")")), side=2, line=4.2,cex = 1.5)
mtext("Years", side=1, line=2.5,cex = 1.5)
# Number of series
num.series <- NULL
for (i in 1:length(nest_start_final)){
num.series[i] <- sum(!is.na((X[(which(nest_years==nest_start_final[i])),])))
}
num.series <- replicate_stats(nest_start_final, nest_stop_final, nest_years, matrix(num.series))
num.series <- as.matrix(t(num.series))
colnames(num.series) <- "num.series"
# Instrumental period fit
Q_inst     <- Q[Q_years>=1956 & Q_years<=stop,1]
Y.fit_inst <- Y.fit.final[nest_years>=1956 & nest_years <=stop,2]
boot.r <- NULL # So that R^2 is not biased by trends in streamflow/reconstruction
for (i in 1:1000)
{
ix <- which(!is.na(Q_inst))
ix.boot <- sample(ix,length(ix),replace = T)
boot.r[i] <- cor(Q_inst[ix.boot],Y.fit_inst[ix.boot])
remove(ix,ix.boot)
}
print("Bootstrapped R^2:")
print(quantile(boot.r,c(0.05,0.50,0.95))^2)
r.sq       <- summary(lm(Q_inst~Y.fit_inst))$"r.squared"
print("Simple R^2")
print(r.sq)
par(mfrow=c(1,1),
mar=c(2,4.5,0.2,0),
oma=c(2,3,0,.35))
plot(nest_years,Y.fit.final[,2], type='l', ylab='', xlab="", yaxt='n', xaxt ='n',
ylim=c(y.lim.1,y.lim.2), xlim=c(1950, 2010), lwd=2, las=1,
col="firebrick") #cex.lab=1.5, cex.axis=1.5
mtext(expression(paste("Discharge (",m^3,"/",s,")")), side=2, line=5)
lines(Q_years, Q[,1], col="darkblue", lwd=2)
y_ticks <- round(seq(y.lim.1,y.lim.2, by = (y.lim.2-y.lim.1)/4))
axis(side=2, las=1, at = y_ticks, labels=format(y_ticks,big.mark=",", scientific=FALSE), cex.lab=1.3, cex.axis = 1.15)
axis(side=1, at=seq(1950,2010,by=10),cex.lab=1.3, cex.axis = 1.15)
text(2000,(y.lim.1),paste("R^2: ",round(median(boot.rsq)*100,2), "%", sep=""), cex=1.6)
mtext("Years", side=1, line=2.5,cex = 1.5)
# Saving reconstruction outputs and calibration validation statistics
# write.csv(Y.fit.final,file ="recon.out/Brahmaputra_JAS_reconstruction.csv",quote = F)
# write.csv(num.series   ,file ="recon.out/n.series.csv",quote = F)
# write.csv(cal.ver.out  ,file ="recon.out/cal.ver.out.csv",quote = F)
as.numeric(rownames(X_details))
# Calibration period correlations b/w PC series and JAS discharge
X.cal <- X[nest_years>=1956 & nest_years <=1998,]
Q.cal <- Q[Q_years>=1956 & Q_years<=1998,]
library("psych")   # PCA
r_PC_flow <- NULL
n <- c(28,25,22,21,20,14,12,11,10)
t <- NULL
for (i in 1:length(n)) {
t[i] <- (28-(n[i])+1)
X_cal_temp <- X.cal[,seq(t[i],28)]
X.PC.scores <- principal(X_cal_temp, nfactors=ncol(X_cal_temp),rotate = "none")
r_PC_flow <- rbind(r_PC_flow,apply(X.PC.scores$scores[,seq(1:8)],2,function(x) cor(x,Q.cal,use='pairwise')))
}
apply(abs(r_PC_flow),2,median)
apply(r_PC_flow,2,min)
apply(r_PC_flow,2,max)
